
(send vista-menu-item-proto 
            :new "Labels Plot"                                    ;NEW DEF
            :ok-data-types '("class" "univariate" "bivariate" 
                                     "multivariate" "general")
            :enabled t
            :action  #'(lambda () (labels-plot)))

(defun labels-plot 
  (&optional data 
        &key (style 0) 
             (help-only nil)
             (show t)
             (top-most t) 
             (location '(50 50)) 
             (size '(125 320))
             (menu t) 
             (title "Labels") 
             (go-away t) 
             (content-only nil)
             (in nil in??) 
             (in? nil in???))
  (let* ((actcon *active-container*)
         (in? (if in??? in? in??))
         (graph-frame (graph-frame :show nil))
         (pop-out (send graph-frame :seen-in in in?))
         (container (if (equal pop-out t) graph-frame pop-out))
         (names (before-labels-plot data))
         (data-object (if (objectp data) data (if (not data) $)))
         (vertical t)
         (linkable t)
         (graph))
    (when help-only (setf vertical nil))
    (setf graph (name-list
                 names 
                 :help-only help-only
                 :show t
                 :title title 
                 :size size 
                 :location '(3000 3000)
                 :in container 
                 :style style 
                 :vertical vertical))
    (if actcon 
        (enable-container actcon)
        (disable-container))
    (when graph
          (send graph :pop-out nil)	
          (send (send graph :container) :after-new-container 
                pop-out top-most show size container linkable data-object)
          (when show (apply #'send (send graph :container) :location location))
          )
    graph))


  (defun before-labels-plot (data)
    "ARGS: DATA
Prepares data for input to a labels plot module. DATA may be NIL, a DATA OBJECT, or a LIST of strings. Returns a list of labels"
    (let* ((variable-labels) 
           (point-labels) 
           (title) 
           (result))
      (unless data (setf data $))
      (setf result
            (cond
              ((objectp data)                                   ;data is an object
               (send data :active-labels))
              ((and (listp data) (stringp (first data)))        ;data is a list of strings
               data)))
      result))

(defmeth container-proto :after-new-plot 
  (pop-out top-most show plot size actcon linkable dob)
  (when plot
        (send self :graphs (append (send self :graphs) (list plot)))
        (send plot :after-new-plot pop-out top-most show size actcon linkable dob)
        (if actcon 
            (enable-container actcon)
            (disable-container)))
  plot)

(defmeth container-proto :after-new-container 
  (pop-out top-most show size actcon linkable dob)
    (unless (send actcon :n-graphs) (send actcon :n-graphs 0))
    (send actcon :n-graphs (1+ (send actcon :n-graphs)))
    (let* ((menu (send self :menu))
           (floc (* (- (send actcon :n-graphs) 1) '(20 20)))
          ; (overlay (length (send self :overlays)))
           )
     ; (ignore-errors 
     ;  (when overlay
     ;        (dotimes (i overlay)
     ;                 (send (select (send self :overlays) i) :remove-button ':pop)
     ;                 (send (select (send self :overlays) i) :remove-button ':zoom))))
      (when (> (+ (first floc) (first size)) (first *effective-screen-size*))
            (send actcon :n-graphs 0)
            (setf (select floc 0) 0))
      (when (> (+ (second floc) (second size)) (second *effective-screen-size*))
            (setf (select floc 1) 
                  (+ (- (second floc) (second *effective-screen-size*)) (second size))))
      (apply #'send self :frame-location floc)
      
      (send self :pop-out-on pop-out)
      (send self :top-most-on top-most)
      (send self :data-object dob)
    ;  (send self :container actcon)
      (when show (apply #'send self :location (+ (send self :location) 2000)))
      (when pop-out 
            (send self :pop-out t)
            (apply #'send self :frame-size size))
      (when menu 
            (send menu :remove)
            (when show (send self :redraw))
            (defmeth self :do-click (x y m1 m2)
              (call-next-method x y m1 m2)
              (when m2 (send (send self :menu) :popup-menu x y self))))
      
    ;  (when linkable (send self :setup-linkage ))

      (when show 
            (apply #'send self :location (- (send self :location) 2000))
            (send self :show-window))
      
      (setf *current-plot* self)
      (setf *cp* self)
      (setf *graph* self)
      self))


(defmeth container-proto :data-object (&optional (objid nil set))
"Args: (&optional objid) data-object slot."
  (unless (send self :has-slot 'data-object)
          (send self :add-slot 'data-object))
  (if set (setf (slot-value 'data-object) objid))
  (slot-value 'data-object))
  
(defmeth container-proto :graphs (&optional (num nil set))
  "Message args: (&optional num)
 Sets or retrieves the number of graphs for graph location."
  (unless (send self :has-slot 'graphs)
          (send self :add-slot 'graphs))
  (if set (setf (slot-value 'graphs) num))
  (slot-value 'graphs))

(defmeth container-proto :pop-out-on (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves whether graphs can be popped out."
  (unless (send self :has-slot 'pop-out-on)
          (send self :add-slot 'pop-out-on))
  (if set (setf (slot-value 'pop-out-on) logical))
  (slot-value 'pop-out-on)) 

(defmeth container-proto :top-most-on (&optional (logical nil set))
"Message args: (&optional logical)
 Sets or retrieves whether graphs can be made to be top most."
  (unless (send self :has-slot 'top-most-on)
          (send self :add-slot 'top-most-on))
  (if set (setf (slot-value 'top-most-on) logical))
  (slot-value 'top-most-on)) 


